home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / tm / signature.el.z / signature.el
Encoding:
Text File  |  1998-05-21  |  5.0 KB  |  161 lines

  1. ;;; signature.el --- a signature utility for GNU Emacs
  2.  
  3. ;; Copyright (C) 1994,1995,1996 Free Software Foundation, Inc.
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;;         OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
  7. ;;         Artur Pioro <artur@flugor.if.uj.edu.pl>
  8. ;;         KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
  9. ;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
  10. ;; Created: 1994/7/11
  11. ;; Version:
  12. ;;    $Id: signature.el,v 7.13 1996/08/30 04:34:56 morioka Exp $
  13. ;; Keywords: mail, news, signature
  14.  
  15. ;; This file is part of tm (Tools for MIME).
  16.  
  17. ;; This program is free software; you can redistribute it and/or
  18. ;; modify it under the terms of the GNU General Public License as
  19. ;; published by the Free Software Foundation; either version 2, or (at
  20. ;; your option) any later version.
  21.  
  22. ;; This program is distributed in the hope that it will be useful, but
  23. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  24. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  25. ;; General Public License for more details.
  26.  
  27. ;; You should have received a copy of the GNU General Public License
  28. ;; along with this program; see the file COPYING.  If not, write to
  29. ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  30. ;; Boston, MA 02111-1307, USA.
  31.  
  32. ;;; Code:
  33.  
  34. (require 'std11)
  35.  
  36.  
  37. ;;; @ valiables
  38. ;;;
  39.  
  40. (defvar signature-insert-at-eof nil
  41.   "*If non-nil, insert signature at the end of file.")
  42.  
  43. (defvar signature-delete-blank-lines-at-eof nil
  44.   "*If non-nil, signature-insert-at-eof deletes blank lines at the end
  45. of file.")
  46.  
  47. (defvar signature-load-hook nil
  48.   "*List of functions called after signature.el is loaded.")
  49.  
  50. (defvar signature-file-name "~/.signature"
  51.   "*Name of file containing the user's signature.")
  52.  
  53. (defvar signature-file-alist nil)
  54.  
  55. (defvar signature-file-prefix nil
  56.   "*String containing optional prefix for the signature file names")
  57.  
  58. (defvar signature-insert-hook nil
  59.   "*List of functions called before inserting a signature.")
  60.  
  61. (defvar signature-use-bbdb nil
  62.   "*If non-nil, Register sigtype to BBDB.")
  63.  
  64. ;;;
  65. ;;; Example:
  66. ;;;
  67. ;;; (setq signature-file-alist
  68. ;;;       '((("Newsgroups" . "zxr")   . "~/.signature-sun")
  69. ;;;         (("To" . "uramimi")       . "~/.signature-sun")
  70. ;;;         (("Newsgroups" . "jokes") . "~/.signature-jokes")
  71. ;;;         (("To" . "tea")           . "~/.signature-jokes")
  72. ;;;         (("To" . ("sim" "oku"))   . "~/.signature-formal")
  73. ;;;         ))
  74.  
  75. (autoload 'signature/get-sigtype-from-bbdb "tm-bbdb")
  76.  
  77. (defun signature/get-sigtype-interactively (&optional default)
  78.   (read-file-name "Insert your signature: "
  79.                   (or default (concat signature-file-name "-"))
  80.                   (or default signature-file-name)
  81.                   nil))
  82.  
  83. (defun signature/get-signature-file-name ()
  84.   (save-excursion
  85.     (save-restriction
  86.       (narrow-to-region
  87.        (goto-char (point-min))
  88.        (if (re-search-forward
  89.             (concat "^" (regexp-quote mail-header-separator) "$")
  90.             nil t)
  91.            (match-beginning 0)
  92.          (point-max)
  93.          ))
  94.       (catch 'found
  95.         (let ((alist signature-file-alist) cell field value)
  96.           (while alist
  97.             (setq cell  (car alist)
  98.                   field (std11-field-body (car (car cell)))
  99.                   value (cdr (car cell)))
  100.             (cond ((functionp value)
  101.            (let ((name (apply value field (cdr cell))))
  102.              (if name
  103.              (throw 'found
  104.                 (concat signature-file-prefix name))
  105.                )))
  106.           ((stringp field)
  107.            (cond ((consp value)
  108.               (while value
  109.                 (if (string-match (car value) field)
  110.                 (throw 'found
  111.                        (concat
  112.                     signature-file-prefix (cdr cell)))
  113.                   (setq value (cdr value))
  114.                   )))
  115.              ((stringp value)
  116.               (if (string-match value field)
  117.                   (throw 'found
  118.                      (concat
  119.                       signature-file-prefix (cdr cell)))
  120.                 )))))
  121.             (setq alist (cdr alist))
  122.             ))
  123.         signature-file-name))))
  124.  
  125. (defun insert-signature (&optional arg)
  126.   "Insert the file named by signature-file-name.
  127. It is inserted at the end of file if signature-insert-at-eof is non-nil,
  128. and otherwise at the current point.  A prefix argument enables user to
  129. specify a file named <signature-file-name>-DISTRIBUTION interactively."
  130.   (interactive "P")
  131.   (let ((signature-file-name
  132.          (expand-file-name
  133.           (or (and signature-use-bbdb
  134.                    (signature/get-sigtype-from-bbdb arg))
  135.               (and arg
  136.                    (signature/get-sigtype-interactively))
  137.               (signature/get-signature-file-name))
  138.           )))
  139.     (or (file-readable-p signature-file-name)
  140.         (error "Cannot open signature file: %s" signature-file-name))
  141.     (if signature-insert-at-eof
  142.         (progn
  143.           (goto-char (point-max))
  144.           (or (bolp) (insert "\n"))
  145.           (if signature-delete-blank-lines-at-eof (delete-blank-lines))
  146.           ))
  147.     (run-hooks 'signature-insert-hook)
  148.     (insert-file-contents signature-file-name)
  149.     (force-mode-line-update)
  150.     signature-file-name))
  151.  
  152.  
  153. ;;; @ end
  154. ;;;
  155.  
  156. (provide 'signature)
  157.  
  158. (run-hooks 'signature-load-hook)
  159.  
  160. ;;; signature.el ends here
  161.